home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mididemo / midiplay.bas < prev    next >
BASIC Source File  |  1995-05-09  |  3KB  |  69 lines
  1. ' Disclaimer of Warranty:
  2.  
  3. ' This software and the accompanying files are provided "as is"
  4. ' and without warranties as to performance of the software and
  5. ' the accompanying files or any other warranties whether expressed
  6. ' or implied.  No warranty of fitness for a particular purpose
  7. ' is offered.
  8. '
  9. ' You may not sell this software or it's source code.
  10. ' You may use this code in any way you find useful.
  11.  
  12.  
  13. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  14. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplication As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal FileStr As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  15.  
  16. Global SongFileName  As String  'File Name of the midi file
  17. Global Index As Integer         'Element counter for SongTitleArrray()
  18. Global CRLF As String           'Carriage Return and Line Feed
  19. Global SongLength As String     'Variable for length of time of a song
  20.  
  21. ' low level MIDI Functions
  22. Declare Function MidiOutOpen Lib "mmsystem.dll" (hMidiOut As Long, ByVal DeviceId As Integer, ByVal C As Long, ByVal I As Long, ByVal F As Long) As Integer
  23. Declare Function MidiOutShortMsg Lib "mmsystem.dll" (ByVal hMidiOut As Integer, ByVal MidiMessage As Long) As Integer
  24. Declare Function MidiOutGetNumDevs Lib "mmsystem.dll" () As Integer
  25. Declare Function MidiOutClose Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  26. Declare Function MidiOutReset Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  27.  
  28.  
  29. Global MidiEventOut, MidiNoteOut, MidiVelOut As Long
  30.  
  31. Global hMidiOut As Long
  32. Global hMidiOutCopy As Long 'integer
  33. 'Global MidiOpenError As String
  34. Global MidiOpenError As Integer
  35. Global Const MIDI_MAPPER = -1
  36.  
  37. ' The current Midi Channel out set on MidiPlayer form
  38. Global MidiChannelOut As Integer
  39.  
  40. Function FileExists (FileName As String) As Integer
  41.     'This sub checks for the existance of any filename passed to it
  42.  
  43.     If Len(Dir$(FileName)) Then
  44.         FileExists = True
  45.     Else
  46.         FileExists = False
  47.     End If
  48. End Function
  49.  
  50. Sub MidiReset ()
  51.  
  52.     'This sub will reset the midi sequencer
  53.     'These are not MCI commands, but deal directly with the device
  54.     
  55.     'Open Midi Out while song is not playing
  56.     
  57.     'hMidiOut is filled with a value upon successful completion
  58.     MidiOpenError = MidiOutOpen(hMidiOut, MIDI_MAPPER, 0, 0, 0)
  59.     hMidiOutCopy = hMidiOut
  60.     
  61.     a% = MidiOutReset(hMidiOutCopy)
  62.     'Both these functions take a second or two to complete,
  63.     'therefore, use DoEvents to wait for them.
  64.     DoEvents
  65.     b% = MidiOutClose(hMidiOutCopy)
  66.     DoEvents
  67. End Sub
  68.  
  69.